home *** CD-ROM | disk | FTP | other *** search
/ Chip 1997 January / CHIP Turkiye Ocak 1997.iso / program / sound / amod30 / modunit.pas < prev    next >
Pascal/Delphi Source File  |  1995-08-11  |  48KB  |  1,495 lines
  1. {AdnMod 0.30 by Beta/Adrenalin.
  2.  GUS only
  3.  Thanks to:
  4.     Gravis for great soundcard
  5.     flap / Capacala for sending me "some" info
  6.     Mark Feldman for PCGPE
  7.     Mark Dixon for his GUS669 source
  8.     Thunder for excellent info about MODs
  9.     Tran & Joshua C. Jensen for releasing ultradox
  10.  
  11.  Greets:
  12.     Wihannes / Nordic vision
  13.     Solar / Hysteria
  14.     sshadow / a-men pc
  15.     Wog / a-men pc
  16.     Psyko / Acidface software
  17.     ASYLUM.ZIP
  18.     All users of Metropoli & Starport
  19. }
  20. unit modunit;
  21. {$s-}
  22. interface
  23. uses dos,modtypes;
  24.  
  25. const
  26. maxchn = 14;   {max # of channels in mod.}
  27. amp_vol : byte = 11;  {amplifying volume. Increasing by one doubles
  28.                        the volume}
  29.  
  30. def_pan : byte = 4;        {default panning. 0-7}
  31.  
  32. max_per = 900;          {Max & min period for Amiga limits}
  33. min_per = 20;            {not implemented anymore because of extra octaves}
  34. Base : word = $200;       {GUS address}
  35.  
  36. ramp_speed = 63;
  37. mod_error : word = 0;
  38. {0 = no error
  39.  1 = too many channels
  40.  2 = load error
  41.  3 = out of pattern memory
  42.  255 = other error}
  43.  
  44. {1536 bytes}
  45. per_table : array[0..15,1..48] of word = (
  46.    (856,808,762,720,678,640,604,570,538,508,480,453,
  47.    428,404,381,360,339,320,302,285,269,254,240,226,
  48.    214,202,190,180,170,160,151,143,135,127,120,113,
  49.    107,101,95,90,85,80,75,71,67,63,60,56),
  50.  
  51. (850,802,757,715,674,637,601,567,535,505,477,450,{ : C-1 to B-1 Finetune +1}
  52. 425,401,379,357,337,318,300,284,268,253,239,225, { : C-2 to B-2 Finetune +1}
  53. 213,201,189,179,169,159,150,142,134,126,119,113, { : C-3 to B-3 Finetune +1}
  54. 106,100,94,89,84,79,75,71,67,83,59,56),          { : C-4 to B-4 Finetune +1}
  55.  
  56.  
  57. (844,796,752,709,670,632,597,563,532,502,474,447,{ : C-1 to B-1 Finetune +2}
  58. 422,398,376,355,335,316,298,282,266,251,237,224, { : C-2 to B-2 Finetune +2}
  59. 211,199,188,177,167,158,149,141,133,125,118,112, { : C-3 to B-3 Finetune +2}
  60. 105, 99, 94, 88, 83, 79, 74, 70, 66, 62, 59, 56),{ : C-4 to B-4 Finetune +2}
  61.  
  62. (838,791,746,704,665,628,592,559,528,498,470,444,{ : C-1 to B-1 Finetune +3}
  63. 419,395,373,352,332,314,296,280,264,249,235,222, { : C-2 to B-2 Finetune +3}
  64. 209,198,187,176,166,157,148,140,132,125,118,111, { : C-3 to B-3 Finetune +3}
  65. 104, 99, 93, 88, 83, 78, 74, 70, 66, 62, 59, 55),{ : C-4 to B-4 Finetune +3}
  66.  
  67. (832,785,741,699,660,623,588,555,524,495,467,441,{ : C-1 to B-1 Finetune +4}
  68. 416,392,370,350,330,312,294,278,262,247,233,220, { : C-2 to B-2 Finetune +4}
  69. 208,196,185,175,165,156,147,139,131,124,117,110, { : C-3 to B-3 Finetune +4}
  70. 104, 98, 92, 87, 82, 78, 73, 69, 65, 62, 58, 55),{ ; C-4 to B-4 Finetune +4}
  71.  
  72. (826,779,736,694,655,619,584,551,520,491,463,437,{ : C-1 to B-1 Finetune +5}
  73. 413,390,368,347,328,309,292,276,260,245,232,219, { : C-2 to B-2 Finetune +5}
  74. 206,195,184,174,164,155,146,138,130,123,116,109, { : C-3 to B-3 Finetune +5}
  75. 103, 97, 92, 87, 82, 77, 73, 69, 65, 61, 58, 54),{ ; C-4 to B-4 Finetune +5}
  76.  
  77. (820,774,730,689,651,614,580,547,516,487,460,434,{ : C-1 to B-1 Finetune +6}
  78. 410,387,365,345,325,307,290,274,258,244,230,217, { : C-2 to B-2 Finetune +6}
  79. 205,193,183,172,163,154,145,137,129,122,115,109, { : C-3 to B-3 Finetune +6}
  80. 102, 96, 91, 86, 81, 77, 72, 68, 64, 61, 57, 54),{ : C-4 to B-4 Finetune +6}
  81.  
  82. (814,768,725,684,646,610,575,543,513,484,457,431,{ : C-1 to B-1 Finetune +7}
  83. 407,384,363,342,323,305,288,272,256,242,228,216, { : C-2 to B-2 Finetune +7}
  84. 204,192,181,171,161,152,144,136,128,121,114,108, { : C-3 to B-3 Finetune +7}
  85. 102, 96, 90, 85, 80, 76, 72, 68, 64, 60, 57, 54),{ : C-4 to B-4 Finetune +7}
  86.  
  87. (907,856,808,762,720,678,640,604,570,538,504,480,{ : C-1 to B-1 Finetune -8}
  88. 453,428,404,381,360,339,320,302,285,269,254,240, { : C-2 to B-2 Finetune -8}
  89. 226,214,202,190,180,170,160,151,143,135,127,120, { : C-3 to B-3 Finetune -8}
  90. 113,107,101, 95, 90, 85, 80, 75, 71, 67, 63, 60),{ : C-4 to B-4 Finetune -8}
  91.  
  92.  
  93. (900,850,802,757,715,675,636,601,567,535,505,477,{ : C-1 to B-1 Finetune -7}
  94. 450,425,401,379,357,337,318,300,284,268,253,238, { : C-2 to B-2 Finetune -7}
  95. 225,212,200,189,179,169,159,150,142,134,126,119, { : C-3 to B-3 Finetune -7}
  96. 112,106,100, 94, 89, 84, 79, 75, 71, 67, 63, 59),{ : C-4 to B-4 Finetune -7}
  97. (894,844,796,752,709,670,632,597,563,532,502,474,{ : C-1 to B-1 Finetune -6}
  98. 447,422,398,376,355,335,316,298,282,266,251,237, { : C-2 to B-2 Finetune -6}
  99. 223,211,199,188,177,167,158,149,141,133,125,118, { : C-3 to B-3 Finetune -6}
  100. 111,105, 99, 94, 88, 83, 79, 74, 70, 66, 62, 59),{ : C-4 to B-4 Finetune -6}
  101.  
  102. (887,838,791,746,704,665,628,592,559,528,498,470,{ : C-1 to B-1 Finetune -5}
  103. 444,419,395,373,352,332,314,296,280,264,249,235, { : C-2 to B-2 Finetune -5}
  104. 222,209,198,187,176,166,157,148,140,132,125,118, { : C-3 to B-3 Finetune -5}
  105. 111,104, 99, 93, 88, 83, 78, 74, 70, 66, 62, 59),{ : C-4 to B-4 Finetune -5}
  106.  
  107. (881,832,785,741,699,660,623,588,555,524,494,467,{ : C-1 to B-1 Finetune -4}
  108. 441,416,392,370,350,330,312,294,278,262,247,233, { : C-2 to B-2 Finetune -4}
  109. 220,208,196,185,175,165,156,147,139,131,123,117, { : C-3 to B-3 Finetune -4}
  110. 110,104, 98, 92, 87, 82, 78, 73, 69, 65, 61, 58),{ : C-4 to B-4 Finetune -4}
  111.  
  112. (875,826,779,736,694,655,619,584,551,520,491,463,{ : C-1 to B-1 Finetune -3}
  113. 437,413,390,368,347,338,309,292,276,260,245,232, { : C-2 to B-2 Finetune -3}
  114. 219,206,195,184,174,164,155,146,138,130,123,116, { : C-3 to B-3 Finetune -3}
  115. 109,103, 97, 92, 87, 82, 77, 73, 69, 65, 61, 58),{ : C-4 to B-4 Finetune -3}
  116.  
  117. (868,820,774,730,689,651,614,580,547,516,487,460,{ : C-1 to B-1 Finetune -2}
  118. 434,410,387,365,345,325,307,290,274,258,244,230, { : C-2 to B-2 Finetune -2}
  119. 217,205,193,183,172,163,154,145,137,129,122,115, { : C-3 to B-3 Finetune -2}
  120. 108,102, 96, 91, 86, 81, 77, 72, 68, 64, 61, 57),{ : C-4 to B-4 Finetune -2}
  121.  
  122. (862,814,768,725,684,646,610,575,543,513,484,457,{ : C-1 to B-1 Finetune -1}
  123. 431,407,384,363,342,323,305,288,272,256,242,228, { : C-2 to B-2 Finetune -1}
  124. 216,203,192,181,171,161,152,144,136,128,121,114, { : C-3 to B-3 Finetune -1}
  125. 108,101, 96, 90, 85, 80, 76, 72, 68, 64, 60, 57));{: C-4 to B-4 Finetune -1}
  126.  
  127. gusvol : array[0..64] of word =
  128. (0,1246,1502,1646,1758,1846,1902,1958,2014,2070,
  129. 2102,2130,2158,2186,2214,2242,2270,2298,2326,2344,
  130. 2358,2372,2386,2400,2414,2428,2442,2456,2470,2484,
  131. 2498,2512,2526,2540,2554,2568,2582,2593,2600,2607,
  132. 2614,2621,2628,2635,2642,2649,2656,2663,2670,2677,
  133. 2684,2691,2698,2705,2712,2719,2726,2733,2740,2747,
  134. 2754,2761,2768,2775,2782);
  135.  
  136. vib_tbl : array[0..2,0..63] of shortint =    {192 bytes}
  137. ((0,6,12,19,24,30,36,41,45,49,53,56,59,61,63,64,
  138. 64,64,63,61,59,56,53,49,45,41,36,30,24,19,12,6,
  139. 0,-6,-12,-19,-24,-30,-36,-41,-45,-49,-53,-56,-59,-61,-63,-64,
  140. -64,-64,-63,-61,-59,-56,-53,-49,-45,-41,-36,-30,-24,-19,-12,-6),
  141. (-63,-61,-59,-57,-55,-53,-51,-49,-47,-45,-43,-41,-39,-37,-35,-33,
  142. -31,-29,-27,-25,-23,-21,-19,-17,-15,-13,-11,-9,-7,-5,-3,-1,
  143. 1,3,5,7,9,11,13,15,17,19,21,23,25,27,29,31,
  144. 33,35,37,39,41,43,45,47,49,51,53,55,57,59,61,63),
  145. (-64,-64,-64,-64,-64,-64,-64,-64,-64,-64,-64,-64,-64,-64,-64,-64,
  146. -64,-64,-64,-64,-64,-64,-64,-64,-64,-64,-64,-64,-64,-64,-64,-64,
  147. 64,64,64,64,64,64,64,64,64,64,64,64,64,64,64,64,
  148. 64,64,64,64,64,64,64,64,64,64,64,64,64,64,64,64));
  149.  
  150. type
  151.   t_channel = record
  152.                 Vol : byte;       {current volume 0-64}
  153.                 note : byte;      {current note 1(C-1) to 48(B-4)}
  154.                 Per,dper : word;  {period & dest. period for tone portamentos}
  155.                 Sample : byte;    {current sample}
  156.                 Pan : byte;       {panning}
  157.                 fx,fxdata : byte;
  158.                 fx_sl2,fx_vib : byte;     {slide to & vibrato fx-data}
  159.                 fx_portd,fx_portu : byte; {slide up & down fx-data}
  160.                 fx_trm : byte;            {tremolo fx-data}
  161.                 vib_wave : byte;    {vibrato waveform}
  162.                 vib_cnt : byte;     {vibrato counter}
  163.                 trig_cnt : byte;    {retrig counter}
  164.                 arp1,arp2,         {arpeggio params}
  165.                 arp_cnt : byte;     {arpeggio counter}
  166.                 start_fx : byte;    {tick to start do_fx for channel}
  167.                 on : byte;        {0 = channel is muted}
  168.                 bar : byte;       {volume bar}
  169.                 hit : byte;
  170.                 no_fx : byte;  {1 = do not get new fx}
  171.                 gvol : word;
  172.               end;
  173.   t_sample = record
  174.                Name : array[1..23] of char;
  175.                Addr : longint;  {address in GUS mem}
  176.                Length : word;
  177.                LoopStart,
  178.                LoopEnd : word;
  179.                ftune : byte;
  180.                Volume : byte;
  181.              end;
  182.   t_note = record
  183.              per : word;
  184.              note,
  185.              sample,
  186.              fx,
  187.              fxdata : byte;
  188.            end;
  189.   t_pattern = array[0..(64*14)-1] of t_note;
  190.   p_pattern = ^t_pattern;
  191.  
  192.   mod_header = record
  193.                  name : string[20];
  194.                  Length : integer;
  195.                  tag : array[0..3] of char;  {M.K.}
  196.                  chns : integer;  {1..14}
  197.                  samples : integer; {15 / 31}
  198.                end;
  199.  
  200. var
  201.   gus_addr : array[0..32] of longint;    {128 bytes}
  202.   periods : array[0..1100] of word;      {2200 bytes}
  203.   channels : array[0..maxchn-1] of t_channel;
  204.   samples : array[0..32] of t_sample;    {1120 bytes}
  205.   patterns : array[0..128] of p_pattern; {516 bytes}
  206.   orders : array[0..255] of byte;   {order list}
  207.   max_ptn : word;                   {# patterns in mod}
  208.   cur_ptn,cur_row,cur_tick : byte;
  209.   new_ptn,new_row,jump : byte;      {used in jumps}
  210.   speed,nspeed,tempo : integer;
  211.   vblank : boolean;                 {true = do not use bpm tempos}
  212.   playing,loaded : boolean;   {guess :-)}
  213.  
  214.   header : mod_header;
  215.   top_addr : longint;         {Next free address in GUS mem}
  216.  
  217.   time_counter : longint;      {For syncing with demos. Increments
  218.                                 every 1/18.2 seconds}
  219.   time_counter2 : longint;    {Increments every tick}
  220.   time_counter3 : longint;
  221.  
  222. Procedure GUSDelay;
  223. Function VoicePos( V : Byte) : Longint;
  224. Function  GUSPeek(Loc : Longint) : Byte;
  225. Procedure GUSPoke(Loc : Longint; B : Byte);
  226. Function GUSProbe(adr : word) : Boolean;
  227. Procedure GUSFind;
  228. Function  GUSFindMem : Longint;
  229. Procedure GUSSetFreq( V : Byte; hz : Word);
  230. Procedure GUSVoiceControl( V, B : Byte);
  231. Procedure GUSSetBalance( V, Bal : Byte);
  232. Procedure GUSSetVolume( V : Byte; Vol : Word);
  233. Procedure GUSSetLoopMode( V : Byte);
  234. Procedure GUSStopVoice( V : Byte);
  235. Procedure GUSPlayVoice( V, Mode : Byte;VBegin, VStart, VEnd : Longint);
  236. Procedure GUSPlayAll( V, Mode : Byte;VBegin, VStart, VEnd : Longint;
  237.                       freq,vol : word);
  238. procedure gussetramp(chn,vstart,vend,rate : integer);
  239. procedure gusrelvoice(v : byte);
  240. procedure GusSetOfs(v : byte;vbegin : longint);
  241. Procedure GUSReset;
  242. procedure gusdeinit;
  243.  
  244. procedure updatenotes;
  245. procedure start_playing;
  246. procedure stop_playing;
  247. procedure set_timer(ticks : word);
  248. procedure init_mod;
  249. procedure free_mod;
  250. procedure load_mod(s : string;debug : boolean);
  251. procedure goto_mod(ptn,row : integer);
  252.  
  253.  
  254. implementation
  255. type
  256.   t_memarray = array[0..2000] of word;
  257.   t_memarray2 = array[0..5000] of byte;
  258.  
  259. var
  260.   oldint : procedure;
  261.   int_tick,o_int_tick : word;
  262.   timer_rate,timer_cnt,
  263.   int_rate : word;
  264.  
  265.   gus_bank : longint;
  266.   misc_buf : ^t_memarray2;    {buffer used while loading mod}
  267.   misc_buf2 : ^t_memarray;      {points to misc_buf}
  268.  
  269. {$i gus.inc}
  270.  
  271. {$s-}
  272. procedure get_notes;
  273. var
  274.   chn : byte;
  275.   ptn : byte;
  276.   org_sam,sam,note : byte;
  277.   st_ofs : longint;
  278.   per,dper,vol,freq : word;
  279.   _fx,_fxdata : byte;
  280.   mute: byte;
  281.   _ptn : p_pattern;
  282.   ftune : integer;
  283.   ovol : word;
  284.  
  285. procedure prefx;
  286. var
  287. w : word;
  288. _efxdata : byte;
  289. begin
  290.   case _fx of
  291.     9 : begin
  292.           w := _fxdata*$100;
  293.           st_ofs := w;
  294.           channels[chn].no_fx := 1;
  295.           channels[chn].fx := _fx;
  296.           channels[chn].fxdata := _fxdata;
  297.         end;
  298.     $c : begin
  299.            if _fxdata > 64 then _fxdata := 64;
  300.            vol := _fxdata;
  301.            channels[chn].no_fx := 1;
  302.          end;
  303.     $e : begin
  304.            _efxdata := _fxdata and 15;
  305.            case _fxdata shr 4 of
  306.              4 : begin
  307.                 channels[chn].fx := _fx;
  308.                  channels[chn].fxdata := _fxdata;
  309.                  if _efxdata and 3 < 3 then channels[chn].vib_wave := _efxdata
  310.                  else channels[chn].vib_wave := 0 or (_efxdata and 4);
  311.                end;
  312.              $c : if _efxdata and 15 = 0 then begin
  313.                     mute := 1;
  314.                     gusstopvoice(chn);
  315.                   end;
  316.              $d : if _efxdata > 0 then mute := 2
  317.                   else mute := 0;
  318.            end;
  319.     end;
  320.   end;
  321. end;
  322.  
  323. begin
  324.   ptn := orders[cur_ptn];
  325.   _ptn := virt_getptn(ptn);
  326.   for chn := 0 to header.chns-1 do begin
  327.     if channels[chn].fx = 0 then begin
  328.       sam := channels[chn].sample;
  329.       per := per_table[samples[sam].ftune,
  330.                        channels[chn].note];
  331.       gussetfreq(chn,periods[per]);
  332.     end;
  333.     channels[chn].hit := 0;
  334.     if ((_ptn^[cur_row*header.chns+chn].per > 0) or
  335.     (_ptn^[cur_row*header.chns+chn].sample > 0)) then begin
  336.       mute := 1;
  337.       vol := channels[chn].vol;
  338.       per := channels[chn].per;
  339.       note := channels[chn].note;
  340.       freq := periods[channels[chn].per];
  341.       _fx := _ptn^[cur_row*header.chns+chn].fx;
  342.       _fxdata := _ptn^[cur_row*header.chns+chn].fxdata;
  343.       org_sam := _ptn^[cur_row*header.chns+chn].sample;
  344.       channels[chn].start_fx := 0;
  345.       channels[chn].trig_cnt := 0;
  346.       if org_sam = 0 then begin
  347.         sam := channels[chn].sample;
  348.       end
  349.       else begin
  350.         sam := org_sam;
  351.       end;
  352.       ftune := samples[sam].ftune;
  353.       if (_fx = $e) and (_fxdata shr 4 = 5) then ftune := _fxdata and 15;
  354.       if (_fx = 3) or (_fx = 5) then begin {port to/port to&vol slide}
  355.         mute := 1; {dont restart sample}
  356.         if _ptn^[cur_row*header.chns+chn].note > 0 then begin
  357.           note := _ptn^[cur_row*header.chns+chn].note;
  358.           dper := per_table[ftune,note];
  359.           if dper > max_per then dper := max_per;
  360.           if dper < min_per then dper := min_per;
  361.           channels[chn].dper := dper;
  362.         end;
  363.       end
  364.       else if _ptn^[cur_row*header.chns+chn].per > 0 then begin
  365.         if _ptn^[cur_row*header.chns+chn].note > 0 then begin
  366.           note := _ptn^[cur_row*header.chns+chn].note;
  367.           per := per_table[ftune,note];
  368.         end
  369.         else if _ptn^[cur_row*header.chns+chn].per > 0 then
  370.           per := _ptn^[cur_row*header.chns+chn].per;
  371.         if per > max_per then per := max_per;
  372.         if per < min_per then per := min_per;
  373.         channels[chn].dper := per;
  374.         channels[chn].per := per;
  375.         freq := periods[per];
  376.         mute := 0;
  377.       end;
  378.       if org_sam > 0 then begin    {should I reset volume}
  379.         vol := samples[sam].volume;
  380.         if channels[chn].sample <> org_sam then mute := 0;
  381.       end;
  382.       if samples[sam].length > 0 then st_ofs := 2;
  383.         {coz first 2 bytes = amiga loopinfo, discard them}
  384.       channels[chn].no_fx := 0;
  385.       prefx;
  386.       channels[chn].vol := vol;
  387.       channels[chn].note := note;
  388.       if channels[chn].vib_wave and 4 = 0 then channels[chn].vib_cnt := 0;
  389.       channels[chn].sample := sam;
  390.       channels[chn].bar := channels[chn].vol;
  391.       ovol := channels[chn].gvol;
  392.       vol := (gusvol[vol]*amp_vol+20000);
  393.       channels[chn].gvol := vol;
  394.       if st_ofs > samples[sam].length then st_ofs := samples[sam].length;
  395.       if channels[chn].on = 0 then mute := 1;
  396.       if mute = 0 then begin
  397.         channels[chn].hit := 1;
  398.         {gussetbalance(chn,channels[chn].pan);}
  399.         if (samples[sam].loopend > 2) then
  400.           gusplayall(chn,8,gus_addr[sam]+st_ofs,
  401.                                gus_addr[sam]+samples[sam].loopstart,
  402.                                gus_addr[sam]+samples[sam].loopend,freq,
  403.                                20000)
  404.         else gusplayall(chn,0,gus_addr[sam]+st_ofs,
  405.                               gus_addr[sam]+st_ofs,
  406.                               gus_addr[sam]+samples[sam].length,freq,
  407.                               20000);
  408.         gussetramp(chn,20000 shr 8,vol shr 8,ramp_speed);
  409.       end
  410.       else if (channels[chn].on = 1) and (mute=1) then begin
  411.         gussetramp(chn,ovol shr 8,vol shr 8,ramp_speed);
  412.         {gussetvolume(chn,vol);}
  413.       end;
  414.     end;
  415.   end;
  416. end;
  417.  
  418. procedure get_fx;
  419. var
  420. chn,ptn : byte;
  421. _fx,_fxdata : byte;
  422. _efx,_efxdata : byte;
  423. per : word;
  424. b : byte;
  425. w : word;
  426. _ptn : p_pattern;
  427.  
  428. begin
  429.   ptn := orders[cur_ptn];
  430.   _ptn := virt_getptn(ptn);
  431.   new_ptn := cur_ptn;
  432.   new_row := cur_row;
  433.   jump := 0;
  434.   for chn := 0 to header.chns-1 do
  435.   if channels[chn].no_fx = 0 then begin
  436.     _fx := _ptn^[cur_row*header.chns+chn].fx;
  437.     _fxdata := _ptn^[cur_row*header.chns+chn].fxdata;
  438.     if (_fx=0) and (_fxdata = 0) then _fx := 255;
  439.     channels[chn].start_fx := 0;
  440.     channels[chn].fx := _fx;
  441.     channels[chn].fxdata := _fxdata;
  442.     case _fx of
  443.       0 : begin {Arpeggio}
  444.             channels[chn].arp1 := _fxdata shr 4;
  445.             channels[chn].arp2 := _fxdata and 15;
  446.             channels[chn].arp_cnt := 0;
  447.           end;
  448.       1 : begin  {port up}
  449.             channels[chn].start_fx := 2;
  450.           end;
  451.       2 : begin  {port down}
  452.             channels[chn].start_fx := 2;
  453.           end;
  454.       3 : begin   {port to}
  455.             if _fxdata > 0 then begin
  456.               channels[chn].fxdata := _fxdata;
  457.               channels[chn].fx_sl2 := _fxdata;
  458.             end
  459.             else channels[chn].fxdata := channels[chn].fx_sl2;
  460.             channels[chn].start_fx := 2;
  461.           end;
  462.       4 : begin    {vibrato}
  463.             b := _fxdata and 15;
  464.             if b = 0 then b := channels[chn].fx_vib and 15;
  465.             w := b;
  466.             b := _fxdata shr 4;
  467.             if b = 0 then b := channels[chn].fx_vib shr 4;
  468.             w := w or (b shl 4);
  469.             b := w;
  470.             channels[chn].fxdata := b;
  471.             channels[chn].fx_vib := b;
  472.           end;
  473.       5 : begin    {port to & vol slide}
  474.              if _fxdata and 15 > 0 then
  475.                _fxdata := _fxdata and 15; {if both ways, then slide down}
  476.              channels[chn].fxdata := _fxdata;
  477.           end;
  478.       6 : begin      {Vibrato & vol slide}
  479.  
  480.           end;
  481.       7 : begin      {Tremolo}
  482.             if _fxdata > 0 then begin
  483.               channels[chn].fxdata := _fxdata;
  484.               channels[chn].fx_trm := _fxdata;
  485.             end
  486.             else channels[chn].fxdata := channels[chn].fx_trm;
  487.           end;
  488.       8 : begin       {Set dmp-panning}
  489.           end;
  490.       9 : begin   {set sample offset}
  491.             w := _fxdata * 256;
  492.             b := channels[chn].sample;
  493.             if channels[chn].on = 1 then gussetofs(chn,gus_addr[b]+w);
  494.           end;
  495.       $a : begin   {volume slide}
  496.              if _fxdata and 15 > 0 then
  497.                _fxdata := _fxdata and 15; {if both ways, then slide up}
  498.              channels[chn].fxdata := _fxdata;
  499.              channels[chn].start_fx := 2;
  500.            end;
  501.       $b : begin   {position jump}
  502.              if _fxdata < header.length then begin
  503.                new_ptn := _fxdata;
  504.                new_row := 0;
  505.                jump := 1;
  506.              end;
  507.            end;
  508.       $c : begin  {Set volume}
  509.              if _fxdata > 64 then _fxdata := 64;
  510.              channels[chn].fxdata := _fxdata;
  511.              channels[chn].vol := _fxdata;
  512.              channels[chn].bar := _fxdata;
  513.              w := channels[chn].gvol;
  514.              channels[chn].gvol := gusvol[_fxdata]*amp_vol+20000;
  515.              if channels[chn].on = 1 then begin
  516.                gussetvolume(chn,w);
  517.                gussetramp(chn,w shr 8,channels[chn].gvol shr 8,ramp_speed);
  518.              end;
  519.            end;
  520.       $d : begin   {break pattern}
  521.              new_ptn := cur_ptn;
  522.              inc(new_ptn);
  523.              new_row := ((_fxdata and $f0) shr 4)*10+_fxdata and 15;
  524.              jump := 1;
  525.            end;
  526.       $e : begin        {extended effect}
  527.              _efx := _fxdata shr 4;
  528.              _efxdata := _fxdata and 15;
  529.              case _efx of
  530.                1 : begin    {fine portamento up}
  531.                      per := channels[chn].per;
  532.                      inc(per,_efxdata);
  533.                      if per > max_per then per := max_per;
  534.                      channels[chn].per := per;
  535.                      w := periods[channels[chn].per];
  536.                      gussetfreq(chn,w);
  537.                    end;
  538.                2 : begin    {fine portamento down}
  539.                      per := channels[chn].per;
  540.                      dec(per,_efxdata);
  541.                      if per < min_per then per := min_per;
  542.                      channels[chn].per := per;
  543.                      w := periods[channels[chn].per];
  544.                      gussetfreq(chn,w);
  545.                    end;
  546.                4 : begin {set vibrato waveform}
  547.                      channels[chn].vib_wave := _efxdata;
  548.                    end;
  549.                5 : begin
  550.                    end;
  551.                8 : begin  {set mtm-pan}
  552.                      channels[chn].pan := _efxdata;
  553.                      gussetbalance(chn,_efxdata);
  554.                    end;
  555.                9 : if _efxdata > 0 then begin   {retrigger}
  556.                      channels[chn].trig_cnt := _efxdata;
  557.                    end;
  558.                $a : begin   {fine vol slide up}
  559.                       b := channels[chn].vol;
  560.                       inc(b,_efxdata);
  561.                       if b > 64 then b := 64;
  562.                       channels[chn].vol := b;
  563.                       channels[chn].gvol := gusvol[b]*amp_vol+20000;
  564.                       if channels[chn].on = 1 then
  565.                         gussetvolume(chn,channels[chn].gvol);
  566.                       channels[chn].bar := b;
  567.                     end;
  568.                $b : begin   {fine vol slide down}
  569.                       b := channels[chn].vol;
  570.                       dec(b,_efxdata);
  571.                       if b > 128 then b := 0;
  572.                       channels[chn].vol := b;
  573.                       channels[chn].gvol:= gusvol[b]*amp_vol+20000;
  574.                       if channels[chn].on = 1 then
  575.                         gussetvolume(chn,channels[chn].gvol);
  576.                       channels[chn].bar := b;
  577.                     end;
  578.                $c : begin  {cut note}
  579.                     end;
  580.                $d : if _efxdata > 0 then begin {note delay}
  581.                       channels[chn].start_fx := _efxdata+1;
  582.                     end
  583.                     else channels[chn].fx := 255;
  584.              end;
  585.            end;
  586.       $f : begin  {set speed}
  587.              if (_fxdata <= 32) or vblank then begin    {SPEED not tempo}
  588.                nspeed := _fxdata;
  589.                speed := _fxdata;
  590.              end
  591.              else begin                   {Tempo}
  592.                tempo := _fxdata;
  593.                {timer_rate := 2500 div (tempo);}
  594.                asm
  595.                  mov  ax,tempo   {round}
  596.                  shr  ax,1
  597.                  add  ax,2500
  598.                  mov  dx,0
  599.                  mov  cx,tempo
  600.                  div  cx
  601.                  mov  timer_rate,ax
  602.                end;
  603.                {set_timer(int_rate);}
  604.              end;
  605.            end
  606.       else begin
  607.         channels[chn].fx := 255;
  608.         channels[chn].fxdata := 0;
  609.       end;
  610.     end;
  611.   end
  612.   else channels[chn].no_fx := 0;
  613. end;
  614.  
  615. procedure do_fx;
  616. var
  617. chn : byte;
  618. _fx,_fxdata : byte;
  619. _efx,_efxdata : byte;
  620. per : word;
  621. b : byte;
  622. s : shortint;
  623. w : word;
  624.  
  625. begin
  626.   for chn := 0 to header.chns-1 do if channels[chn].on = 1 then begin
  627.     if channels[chn].start_fx > 0 then dec(channels[chn].start_fx);
  628.     _fx := channels[chn].fx;
  629.     _fxdata := channels[chn].fxdata;
  630.     if (channels[chn].on = 1) and (channels[chn].start_fx = 0)
  631.     then case _fx of
  632.       0 : with channels[chn] do begin  {arpeggio}
  633.             case channels[chn].arp_cnt mod 3 of
  634.               0 : gussetfreq(chn,
  635.                     periods[per_table[samples[sample].ftune,note]]);
  636.               1 : gussetfreq(chn,
  637.                     periods[per_table[samples[sample].ftune,note+arp1]]);
  638.               2 : gussetfreq(chn,
  639.                     periods[per_table[samples[sample].ftune,note+arp2]]);
  640.             end;
  641.             inc(arp_cnt);
  642.           end;
  643.       1 : begin   {port up}
  644.             per := channels[chn].per;
  645.             dec(per,_fxdata);
  646.             if per < min_per then per := min_per;
  647.             channels[chn].per := per;
  648.             gussetfreq(chn,periods[per]);
  649.           end;
  650.       2 : begin  {port down}
  651.             per := channels[chn].per;
  652.             inc(per,_fxdata);
  653.             if per > max_per then per := max_per;
  654.             channels[chn].per := per;
  655.             gussetfreq(chn,periods[per]);
  656.           end;
  657.       3 : begin   {Port to}
  658.             if channels[chn].per < channels[chn].dper then begin
  659.               w := channels[chn].dper;
  660.               per := channels[chn].per;
  661.               inc(per,channels[chn].fx_sl2);
  662.               if per > w then per := w;
  663.               if per > max_per then per := max_per;
  664.               if per < min_per then per := min_per;
  665.               channels[chn].per := per;
  666.               gussetfreq(chn,periods[per]);
  667.             end
  668.             else begin
  669.               w := channels[chn].dper;
  670.               per := channels[chn].per;
  671.               if per-channels[chn].fx_sl2 > per then per := min_per
  672.               else dec(per,channels[chn].fx_sl2);
  673.               if per < w then per := w;
  674.               if per < min_per then per := min_per;
  675.               if per > max_per then per := max_per;
  676.               channels[chn].per := per;
  677.               gussetfreq(chn,periods[per]);
  678.             end;
  679.           end;
  680.       4 : begin    {vibrato}
  681.             _fxdata := channels[chn].fx_vib;
  682.             b := _fxdata and 15;
  683.             s := vib_tbl[channels[chn].vib_wave,channels[chn].vib_cnt];
  684.             s := (s * b) div 64;
  685.             w := channels[chn].per+s;
  686.             if w > max_per then w := max_per;
  687.             if w < min_per then w := min_per;
  688.             b := _fxdata shr 4;
  689.             gussetfreq(chn,periods[w]);
  690.             inc(channels[chn].vib_cnt,b);
  691.             if channels[chn].vib_cnt > 63 then
  692.               channels[chn].vib_cnt := channels[chn].vib_cnt - 64;
  693.           end;
  694.       5 : begin   {volume slide & portamento}
  695.             if _fxdata and 15 > 0 then begin  {slide down}
  696.               b := channels[chn].vol;
  697.               if b-_fxdata >= 0 then dec(b,_fxdata)
  698.               else b := 0;
  699.               if b > 128 then b := 0;
  700.               channels[chn].vol := b;
  701.               channels[chn].bar := b;
  702.               channels[chn].gvol := gusvol[b]*amp_vol+20000;
  703.               gussetvolume(chn,channels[chn].gvol);
  704.             end
  705.             else begin      {slide up}
  706.               b := channels[chn].vol;
  707.               inc(b,_fxdata shr 4);
  708.               if b > 64 then b := 64;
  709.               channels[chn].vol := b;
  710.               channels[chn].bar := b;
  711.               channels[chn].gvol := gusvol[b]*amp_vol+20000;
  712.               gussetvolume(chn,channels[chn].gvol);
  713.             end;
  714.             _fxdata := channels[chn].fx_sl2;
  715.             if channels[chn].per < channels[chn].dper then begin {port to}
  716.               w := channels[chn].dper;
  717.               per := channels[chn].per;
  718.               inc(per,_fxdata);
  719.               if per > w then per := w;
  720.               if per > max_per then per := max_per;
  721.               if per < min_per then per := min_per;
  722.               channels[chn].per := per;
  723.               gussetfreq(chn,periods[per]);
  724.             end
  725.             else begin
  726.               w := channels[chn].dper;
  727.               per := channels[chn].per;
  728.               if per-_fxdata > per then per := min_per
  729.               else dec(per,_fxdata);
  730.               if per < w then per := w;
  731.               if per < min_per then per := min_per;
  732.               if per > max_per then per := max_per;
  733.               channels[chn].per := per;
  734.               gussetfreq(chn,periods[per]);
  735.             end;
  736.           end;
  737.       6 : begin     {vibrato & vol slide}
  738.             begin
  739.               b := channels[chn].fx_vib and 15;
  740.               s := vib_tbl[channels[chn].vib_wave,channels[chn].vib_cnt];
  741.               s := (s * b) div 64;
  742.               w := channels[chn].per+s;
  743.               if w > max_per then w := max_per;
  744.               if w < min_per then w := min_per;
  745.               b := channels[chn].fx_vib shr 4;
  746.               gussetfreq(chn,periods[w]);
  747.               inc(channels[chn].vib_cnt,b);
  748.               if channels[chn].vib_cnt > 63 then
  749.                 channels[chn].vib_cnt := channels[chn].vib_cnt - 64;
  750.             end;
  751.             {volume slide}
  752.             if _fxdata and 15 > 0 then begin  {slide down}
  753.               b := channels[chn].vol;
  754.               if b-_fxdata >= 0 then dec(b,_fxdata)
  755.               else b := 0;
  756.               if b > 128 then b := 0;
  757.               channels[chn].vol := b;
  758.               channels[chn].bar := b;
  759.               channels[chn].gvol := gusvol[b]*amp_vol+20000;
  760.               gussetvolume(chn,channels[chn].gvol);
  761.             end
  762.             else begin   {slide up}
  763.               b := channels[chn].vol;
  764.               inc(b,_fxdata shr 4);
  765.               if b > 64 then b := 64;
  766.               channels[chn].vol := b;
  767.               channels[chn].bar := b;
  768.               channels[chn].gvol := gusvol[b]*amp_vol+20000;
  769.               gussetvolume(chn,channels[chn].gvol);
  770.             end;
  771.           end;
  772.       $a : begin  {volume slide}
  773.              if _fxdata and 15 > 0 then begin  {slide down}
  774.                b := channels[chn].vol;
  775.                if b < (_fxdata and 15) then b := 0
  776.                else dec(b,_fxdata and 15);
  777.                if b > 64 then b := 0;
  778.                channels[chn].vol := b;
  779.                channels[chn].bar := b;
  780.                channels[chn].gvol := gusvol[b]*amp_vol+20000;
  781.                gussetvolume(chn,channels[chn].gvol);
  782.              end
  783.              else begin   {slide up}
  784.                b := channels[chn].vol;
  785.                inc(b,_fxdata shr 4);
  786.                if b > 64 then b := 64;
  787.                channels[chn].vol := b;
  788.                channels[chn].bar := b;
  789.                channels[chn].gvol := gusvol[b]*amp_vol+20000;
  790.                gussetvolume(chn,channels[chn].gvol);
  791.              end;
  792.            end;
  793.       $e : begin
  794.              _efx := _fxdata shr 4;
  795.              _efxdata := _fxdata and 15;
  796.              case _efx of
  797.                9 : begin   {Retrig note}
  798.                      b := channels[chn].sample;
  799.                      dec(channels[chn].trig_cnt);
  800.                      if channels[chn].trig_cnt = 0 then begin
  801.                        gussetofs(chn,gus_addr[b]+2);
  802.                        channels[chn].trig_cnt := _efxdata;
  803.                      end;
  804.                    end;
  805.                $c : if _efxdata = 0 then begin     {note cut}
  806.                       gussetvolume(chn,0);
  807.                       channels[chn].gvol := 0;
  808.                     end
  809.                     else begin
  810.                       dec(_efxdata);
  811.                       b := _fxdata;
  812.                       b := b and $f0;
  813.                       b := b or _efxdata;
  814.                       channels[chn].fxdata := b;
  815.                     end;
  816.                $d : begin                    {note delay}
  817.                       channels[chn].start_fx := 255;
  818.                       w := channels[chn].sample;
  819.                       if channels[chn].on = 1 then begin
  820.                         channels[chn].gvol :=
  821.                           gusvol[channels[chn].vol]*amp_vol+20000;
  822.                         channels[chn].hit := 1;
  823.                         gussetbalance(chn,channels[chn].pan);
  824.                         if (samples[w].loopend > 2) then
  825.                           gusplayall(chn,8,gus_addr[w]+2,
  826.                                gus_addr[w]+samples[w].loopstart,
  827.                                gus_addr[w]+samples[w].loopend-1,
  828.                                periods[channels[chn].per],
  829.                                channels[chn].gvol)
  830.                         else  gusplayall(chn,0,gus_addr[w]+2,
  831.                              gus_addr[w],
  832.                              gus_addr[w]+samples[w].length+1,
  833.                              periods[channels[chn].per],
  834.                              channels[chn].gvol);
  835.                       end;
  836.                     end;
  837.              end;
  838.            end;
  839.     end;
  840.   end;
  841. end;
  842.  
  843. procedure updatenotes;
  844. var
  845. n,cptn : integer;
  846. begin
  847.   if cur_ptn >= header.length then new_ptn := 0;
  848.   cur_ptn := new_ptn;
  849.   cur_row := new_row;
  850.   if (cur_tick >= speed) and (speed > 0) then begin
  851.     speed := nspeed;
  852.     cur_tick := 0;
  853.     if jump = 0 then inc(cur_row);
  854.     if cur_row > 63 then begin
  855.       inc(cur_ptn);
  856.       cur_row := 0;
  857.       if cur_ptn > header.length-1 then begin
  858.         new_ptn := 0;
  859.         cur_ptn := 0;
  860.       end;
  861.     end;
  862.   end;
  863.   cptn := orders[cur_ptn];
  864.   new_ptn := cur_ptn;
  865.   new_row := cur_row;
  866.   if speed > 0 then begin
  867.     for n := 0 to maxchn-1 do begin
  868.       if channels[n].bar > 1 then dec(channels[n].bar,2)
  869.       else channels[n].bar := 0;
  870.     end;
  871.     inc(cur_tick);
  872.     if cur_tick = 1 then begin
  873.       virt_needptn(cptn);
  874.       get_notes;
  875.       get_fx;
  876.       virt_noneedptn(cptn);
  877.     end;
  878.     do_fx;
  879.   end;
  880.   if new_ptn <> cur_ptn then virt_warnptn(orders[new_ptn])
  881.   else if cur_row = 63 then begin
  882.     cptn := cur_ptn+1;
  883.     if cptn > header.length-1 then cptn := 0;
  884.     cptn := orders[cptn];
  885.     virt_warnptn(cptn);
  886.   end;
  887.   if jump = 1 then virt_warnptn(orders[new_ptn]);
  888. end;
  889.  
  890. procedure volrampend;
  891. var
  892. chn : integer;
  893. begin
  894.   for chn := 0 to header.chns-1 do begin
  895.     port[active_voice] := chn;
  896.     port[command] := $8d;
  897.     if port[data_high] and 3 = 1 then begin
  898.       port[command] := $d;
  899.       port[data_high] := 2;
  900.       port[command] := 9;
  901.       portw[data_low] := channels[chn].gvol;
  902.     end;
  903.   end;
  904. end;
  905.  
  906. procedure modint; interrupt;
  907. begin
  908.   volrampend;
  909.   dec(timer_cnt);
  910.   inc(time_counter3);
  911.   if timer_cnt < 1 then begin
  912.     inc(time_counter2);
  913.     updatenotes;
  914.     timer_cnt := timer_rate;
  915.   end;
  916.   asm sti end;
  917.   o_int_tick := int_tick;
  918.   int_tick := int_tick + int_rate;
  919.   if o_int_tick > int_tick then begin
  920.     inc(time_counter);
  921.     asm
  922.       pushf
  923.       cli
  924.       call oldint
  925.     end;
  926.   end
  927.   else
  928.     asm
  929.       mov  al,20h
  930.       out  20h,al  {send EOI}
  931.     end;
  932. end;
  933.  
  934. {$s-}
  935. {$f+}
  936. procedure def_virt_alloc(numptn,ptnsize : integer);
  937. var
  938. n : integer;
  939. begin
  940.   for n := 0 to 128 do patterns[n] := nil;
  941.   virt_info.numptn := numptn;
  942.   virt_info.ptnsize := ptnsize;
  943.   virt_info.err_wptn := -1;
  944.   virt_info.err_nptn := -1;
  945. end;
  946.  
  947. procedure def_virt_free;
  948. var
  949. n : integer;
  950. begin
  951.   for n := 0 to 128 do if patterns[n] <> nil then begin
  952.     freemem(patterns[n],virt_info.ptnsize);
  953.     patterns[n] := nil;
  954.   end;
  955. end;
  956.  
  957. procedure def_virt_allocptn(ptn : integer);
  958. begin
  959.   getmem(patterns[ptn],virt_info.ptnsize);
  960. end;
  961.  
  962. procedure def_virt_loadptn(ptn : integer;p : pointer);
  963. begin
  964.   move(p^,patterns[ptn]^,virt_info.ptnsize);
  965. end;
  966.  
  967. procedure def_virt_freeptn(ptn : integer);
  968. begin
  969.   if patterns[ptn] <> nil then begin
  970.     freemem(patterns[ptn],virt_info.ptnsize);
  971.     patterns[ptn] := nil;
  972.   end;
  973. end;
  974.  
  975. function def_virt_getptn(ptn : integer) : pointer;
  976. begin
  977.   def_virt_getptn := patterns[ptn];
  978. end;
  979.  
  980. procedure def_virt_warnptn(ptn : integer);
  981. begin
  982.   virt_info.warnedptn := ptn;
  983. end;
  984.  
  985. procedure def_virt_needptn(ptn : integer);
  986. begin
  987.   if ptn <> virt_info.warnedptn then begin
  988.     virt_info.err_cptn := cur_ptn;
  989.     virt_info.err_wptn := virt_info.warnedptn;
  990.     virt_info.err_nptn := ptn;
  991.   end;
  992. end;
  993.  
  994. procedure def_virt_noneedptn(ptn : integer);
  995. begin
  996. end;
  997.  
  998. {$f-}
  999.  
  1000. {$s-}
  1001. function heaperr(size : word) : integer; far;
  1002. begin
  1003.   if size > 0 then begin
  1004.     mod_error := 3;
  1005.     heaperr := 1;
  1006.   end;
  1007. end;
  1008.  
  1009. procedure load_MOD(s : string;debug : boolean);
  1010. var
  1011. f : file;
  1012. mbuf : pointer;
  1013. oldheaperr : procedure;
  1014.  
  1015. procedure set_up_modheader;
  1016. var
  1017. chn,c,n : integer;
  1018. begin
  1019.   header.samples := 31;
  1020.   header.name[0] := #20;
  1021.   move(misc_buf^[0],header.name[1],20);
  1022.   header.tag := '    ';
  1023.   move(misc_buf^[1080],header.tag,4);
  1024.   chn := maxchn;
  1025.   with header do
  1026.     if tag = 'M.K.' then chn := 4
  1027.     else if tag = 'M!K!' then chn := 4
  1028.     else if tag[1]+tag[2]+tag[3]='CHN' then begin
  1029.       val(tag[0],n,c);
  1030.       if c=0 then chn := n;
  1031.     end
  1032.     else if tag[2]+tag[3]='CH' then begin
  1033.       val(tag[0]+tag[1],n,c);
  1034.       if c=0 then chn := n;
  1035.     end
  1036.     else begin
  1037.       header.samples := 15;
  1038.       chn := 4;
  1039.     end;
  1040.   if chn > maxchn then begin
  1041.     mod_error := 1;
  1042.     exit;
  1043.   end;
  1044.   if header.samples = 15 then begin
  1045.     move(misc_buf^[472],orders[0],128);
  1046.     seek(f,600);
  1047.     header.length := misc_buf^[470];
  1048.     header.chns := 4;
  1049.   end else begin
  1050.     header.length := misc_buf^[950];
  1051.     move(misc_buf^[952],orders[0],128);
  1052.     if debug then writeln('Tag: ',header.tag);
  1053.   end;
  1054.   header.chns := chn;
  1055.   max_ptn := 0;
  1056.   for n := 0 to 127 do if orders[n] > max_ptn then begin
  1057.     if orders[n] > 127 then begin
  1058.       mod_error := 2;
  1059.       exit;
  1060.     end else max_ptn := orders[n];
  1061.   end;
  1062.   max_ptn := max_ptn+1;
  1063. end;
  1064.  
  1065. procedure mod_sample_info;
  1066. var
  1067. n : integer;
  1068. maxi : integer;
  1069. begin
  1070.   for n := 0 to 31 do begin
  1071.     fillchar(samples[n].name,sizeof(samples[n].name),0);
  1072.     samples[n].length := 0;
  1073.     samples[n].ftune := 0;
  1074.     samples[n].volume := 0;
  1075.     samples[n].loopstart := 0;
  1076.     samples[n].loopend := 0;
  1077.   end;
  1078.   for n := 1 to header.samples do begin
  1079.     move(misc_buf^[(n-1)*30+20],samples[n].name[1],22);
  1080.     samples[n].name[23] := #0;
  1081.     samples[n].length := 2*swap(misc_buf2^[(n-1)*15+21]); {n*30+42}
  1082.     samples[n].ftune := misc_buf^[(n-1)*30+44];
  1083.     samples[n].volume := misc_buf^[(n-1)*30+45];
  1084.     samples[n].loopstart := 2*swap(misc_buf2^[(n-1)*15+23]);  {n*30+46}
  1085.     samples[n].loopend := 2*swap(misc_buf2^[(n-1)*15+24]);  {n*30+48}
  1086.     if samples[n].loopend < 3 then begin
  1087.       samples[n].loopend := 0;
  1088.       samples[n].loopstart := 0;
  1089.     end;
  1090.     inc(samples[n].loopend,samples[n].loopstart);
  1091.     if samples[n].loopend > samples[n].length then
  1092.       samples[n].loopend := samples[n].length;
  1093.   end;
  1094. end;
  1095.  
  1096. procedure read_ptn(n : word);
  1097. var
  1098. row,note : integer;
  1099. w,w2,i : word;
  1100. b : byte;
  1101. mchn : byte;
  1102. mb : p_pattern;
  1103.  
  1104. begin
  1105.   mchn := header.chns;
  1106.   mb := mbuf;
  1107.   blockread(f,misc_buf^,256*mchn);
  1108.   for row := 0 to 63 do
  1109.     for note := 0 to mchn-1 do begin
  1110.       w := misc_buf2^[row*(2*mchn)+note*2];
  1111.       w2 := misc_buf2^[row*(2*mchn)+note*2+1];
  1112.       asm
  1113.         mov  cx,w
  1114.         and  cl,15
  1115.         xchg cl,ch
  1116.         and  cx,0fffh
  1117.         mov  i,cx
  1118.       end;
  1119.       mb^[row*header.chns+note].per := i;
  1120.       asm
  1121.         mov  al,byte ptr w2
  1122.         shr  al,4
  1123.         mov  ah,byte ptr w
  1124.         and  ah,11110000b
  1125.         or   al,ah
  1126.         xor  ah,ah
  1127.         mov  i,ax
  1128.       end;
  1129.       mb^[row*header.chns+note].sample := i;
  1130.       mb^[row*header.chns+note].fx := lo(w2) and 15;
  1131.       mb^[row*header.chns+note].fxdata := hi(w2);
  1132.       i := mb^[row*header.chns+note].per;
  1133.       w := 0;
  1134.       repeat
  1135.         inc(w);
  1136.       until (w > 48) or (i = per_table[0,w]);
  1137.       if w <= 48 then mb^[row*header.chns+note].note := w
  1138.       else mb^[row*header.chns+note].note := 0;
  1139.     end;
  1140. end;
  1141.  
  1142. procedure load_patterns;
  1143. var
  1144. num_ptn : longint;
  1145. n : word;
  1146. m_ptn : integer;
  1147. begin
  1148.   if debug then write('Loading patterns');
  1149.   for n := 0 to max_ptn-1 do if mod_error = 0 then begin
  1150.     if debug then write('.');
  1151.     virt_allocptn(n);
  1152.     if mod_error <> 0 then begin
  1153.       virt_free;
  1154.       exit;
  1155.     end;
  1156.     read_ptn(n);
  1157.     virt_loadptn(n,mbuf);
  1158.   end;
  1159.   if debug then writeln;
  1160. end;
  1161.  
  1162. procedure load2gus(len : word);
  1163. var
  1164. {n : word;
  1165. addlo,addhi : word;}
  1166. l : longint;
  1167. begin
  1168.   l := top_addr;
  1169.   asm
  1170.     mov  di,len
  1171.     mov  si,word ptr misc_buf
  1172.     mov  es,word ptr misc_buf+2
  1173.     mov  cx,word ptr l   {cx=addlo}
  1174.     mov  bx,word ptr l+2 {bx=addhi}
  1175.     and  bx,$ff
  1176. @@1:
  1177.       mov  dx,command   {Port [command] := $43;}
  1178.       mov  al,43h
  1179.       out  dx,al
  1180.  
  1181.       mov  dx,data_low  {Portw[data_low] := AddLo;}
  1182.       mov  ax,cx
  1183.       out  dx,ax
  1184.  
  1185.       mov  dx,command    {Port [command] := $44;}
  1186.       mov  al,44h
  1187.       out  dx,al
  1188.  
  1189.       mov  dx,data_high
  1190.       mov  ax,bx
  1191.       out  dx,ax        {Port [data_high] := AddHi;}
  1192.  
  1193.       add  cx,1     {inc(l,1);}
  1194.       adc  bx,0
  1195.  
  1196.     mov  dx,dram_io      {Port [dram_io] := misc_buf^[n];}
  1197.     mov  al,es:[si]
  1198.     out  dx,al
  1199.     inc  si
  1200.  
  1201.     dec  di
  1202.     jnz  @@1
  1203.   end;
  1204.   inc(top_addr,len);
  1205. end;
  1206.  
  1207. procedure load_sample(num : word);
  1208. const
  1209. block = 4096;
  1210. var
  1211. n : longint;
  1212. w : word;
  1213. fl,l : word;
  1214. len : longint;
  1215. b : byte;
  1216.  
  1217. begin
  1218.   if debug then write('.');
  1219.   guspoke(top_addr,0);
  1220.   guspoke(top_addr+1,0);
  1221.   guspoke(top_addr+2,0);
  1222.   inc(top_addr,2);
  1223.   len := samples[num].length+top_addr;
  1224.   if (len > gus_bank+$40000) and (top_addr < gus_bank+$40000) then begin
  1225.     gus_bank := gus_bank+$40000;
  1226.     top_addr := gus_bank;
  1227.   end;
  1228.   samples[num].addr := top_addr;
  1229.   gus_addr[num] := top_addr;
  1230.   if samples[num].length < 1 then begin
  1231.     guspoke(top_addr,0);
  1232.     guspoke(top_addr+1,0);
  1233.     guspoke(top_addr+2,0);
  1234.     inc(top_addr,2);
  1235.     exit;
  1236.   end;
  1237.   fl := (samples[num].length) div block;
  1238.   l := (samples[num].length) mod block;
  1239.   if fl > 0 then for w := 1 to fl do begin
  1240.     blockread(f,misc_buf^,block);
  1241.     load2gus(block);       {load in 4kb blocks}
  1242.   end;
  1243.   if l > 0 then begin
  1244.     blockread(f,misc_buf^,l);
  1245.     load2gus(l);           {load remainder}
  1246.   end;
  1247.   if samples[num].loopend > 2 then begin
  1248.     guspoke(top_addr,guspeek(gus_addr[num]+samples[num].loopstart));
  1249.     {b := guspeek(top_addr-1);
  1250.     guspoke(top_addr,b);}
  1251.     guspoke(top_addr+1,guspeek(gus_addr[num]+samples[num].loopstart));
  1252.     guspoke(gus_addr[num]+samples[num].loopend+1,
  1253.             guspeek(gus_addr[num]+samples[num].loopstart));
  1254.     guspoke(gus_addr[num]+samples[num].loopend,
  1255.             guspeek(gus_addr[num]+samples[num].loopstart));
  1256.     inc(top_addr,2);
  1257.   end
  1258.   else guspoke(top_addr,0);
  1259. end;
  1260.  
  1261. var
  1262. i : integer;
  1263. l : longint;
  1264.  
  1265. begin
  1266.   @oldheaperr := heaperror;
  1267.   heaperror := @heaperr;
  1268.   mod_error := 0;
  1269.   getmem(misc_buf,5000);
  1270.   getmem(mbuf,6000);
  1271.   if mod_error <> 0 then exit;
  1272.   misc_buf2 := addr(misc_buf^);
  1273.   gus_bank := 0;
  1274.   assign(f,s);
  1275.   {$i-}
  1276.   reset(f,1);
  1277.   blockread(f,misc_buf^,1084);  {read module header}
  1278.   i := ioresult;
  1279.   if i <> 0 then begin
  1280.     mod_error := 2;
  1281.     freemem(mbuf,6000);
  1282.     freemem(misc_buf,5000);
  1283.     exit;
  1284.   end;
  1285.   set_up_modheader;
  1286.   if mod_error <> 0 then begin
  1287.     freemem(mbuf,6000);
  1288.     freemem(misc_buf,5000);
  1289.     exit;
  1290.   end;
  1291.   mod_sample_info;
  1292.   virt_alloc(max_ptn,sizeof(t_note)*64*header.chns);
  1293.   load_patterns;
  1294.   if mod_error <> 0 then begin
  1295.     freemem(mbuf,6000);
  1296.     freemem(misc_buf,5000);
  1297.     exit;
  1298.   end;
  1299.   if debug then write('Loading samples');
  1300.   for i := 0 to 31 do load_sample(i);
  1301.   if debug then writeln;
  1302.   close(f);
  1303.   {$i+}
  1304.   freemem(mbuf,6000);
  1305.   freemem(misc_buf,5000);
  1306.   loaded := true;
  1307.   heaperror := @oldheaperr;
  1308. end;
  1309.  
  1310. procedure free_mod;
  1311. var
  1312. n,i : word;
  1313. begin
  1314.   if playing then stop_playing;
  1315.   if not loaded then exit;
  1316.   loaded := false;
  1317.   virt_free;
  1318.   top_addr := 16;
  1319.   for n := 0 to 31 do with samples[n] do begin
  1320.     addr := 0;
  1321.     for i := 0 to sizeof(name) do name[i] := #0;
  1322.     length := 0;
  1323.     loopstart := 0;
  1324.     loopend := 0;
  1325.     ftune := 0;
  1326.     volume := 0;
  1327.   end;
  1328.   gus_bank := 0;
  1329. end;
  1330.  
  1331. procedure goto_mod(ptn,row : integer);
  1332. begin
  1333.   jump := 1;
  1334.   if ptn > header.length-1 then ptn := header.length;
  1335.   if ptn < 0 then ptn := 0;
  1336.   new_ptn := ptn;
  1337.   new_row := row;
  1338.   virt_warnptn(orders[ptn]);
  1339. end;
  1340.  
  1341. procedure initchn(chn : integer);
  1342. begin
  1343.   channels[chn].vol := 0;
  1344.   channels[chn].per := 428;
  1345.   channels[chn].note := 13;
  1346.   channels[chn].sample := 0;
  1347.   channels[chn].pan := 7;  {middle}
  1348.   channels[chn].on := 1;
  1349.   channels[chn].dper := 428;
  1350.   channels[chn].bar := 0;
  1351.   channels[chn].fx := 255;
  1352.   channels[chn].fxdata := 0;
  1353.   channels[chn].fx_sl2 := 0;
  1354.   channels[chn].fx_vib := 0;
  1355.   channels[chn].fx_portu := 0;
  1356.   channels[chn].fx_portd := 0;
  1357.   channels[chn].fx_trm := 0;
  1358.   channels[chn].vib_cnt := 0;
  1359.   channels[chn].vib_wave := 0;
  1360.   channels[chn].hit := 0;
  1361.   channels[chn].no_fx := 0;
  1362.   channels[chn].start_fx := 0;
  1363.   channels[chn].arp1 := 0;
  1364.   channels[chn].arp2 := 0;
  1365.   channels[chn].arp_cnt := 0;
  1366.   channels[chn].gvol := 0;
  1367. end;
  1368.  
  1369. procedure init_mod;
  1370. var
  1371. n,i : integer;
  1372. l : longint;
  1373.  
  1374. begin
  1375.   virt_info.err_wptn := -1;
  1376.   virt_info.err_nptn := -1;
  1377.   virt_info.err_cptn := -1;
  1378.   virt_error := 0;
  1379.   virt_alloc := def_virt_alloc;
  1380.   virt_free := def_virt_free;
  1381.   virt_allocptn := def_virt_allocptn;
  1382.   virt_loadptn := def_virt_loadptn;
  1383.   virt_freeptn := def_virt_freeptn;
  1384.   virt_getptn := def_virt_getptn;
  1385.   virt_warnptn := def_virt_warnptn;
  1386.   virt_needptn := def_virt_needptn;
  1387.   virt_noneedptn := def_virt_noneedptn;
  1388.   for n := 10 to 1050 do begin
  1389.        {gusperiod:=586580935 div (amigaperiod * (divisor div 100 shl 4))}
  1390.        {divisor = 44100}
  1391.     l := n;
  1392.     l := 586580935 div (l * 7056);
  1393.     periods[n] := l;
  1394.     {hz = 7093789.2/(per*2)}
  1395.   end;
  1396.   for n := 0 to 255 do orders[n] := 0;
  1397.   for n := 0 to maxchn-1 do begin
  1398.     initchn(n);
  1399.     gussetbalance(n,channels[n].pan);
  1400.   end;
  1401.   for n := 0 to 31 do with samples[n] do begin
  1402.     addr := 0;
  1403.     for i := 0 to sizeof(name) do name[i] := #0;
  1404.     length := 0;
  1405.     loopstart := 0;
  1406.     loopend := 0;
  1407.     ftune := 0;
  1408.     volume := 0;
  1409.   end;
  1410.   for n := 0 to 13 do gussetvolume(n,0);
  1411.   for n := 0 to 13 do gusstopvoice(n);
  1412.   for n := 0 to 13 do gussetbalance(n,7);
  1413.   fillchar(header,sizeof(header),0);
  1414.   header.chns := 4;
  1415.   playing := false;
  1416.   loaded := false;
  1417.   cur_ptn := 0;
  1418.   cur_row := 0;
  1419.   new_ptn := 0;
  1420.   new_row := 0;
  1421.   cur_tick := 0;
  1422.   for n := 0 to 31 do guspoke(n,0);
  1423.   top_addr := 16;
  1424.   gus_bank := 0;
  1425.   vblank := false;
  1426.   getintvec(8,@oldint);
  1427. end;
  1428.  
  1429. {$s-}
  1430. procedure set_timer(ticks : word);
  1431. begin
  1432.   asm cli end;
  1433.   port[$43] := $36;
  1434.   port[$40] := lo(ticks);
  1435.   port[$40] := hi(ticks);
  1436.   asm sti end;
  1437. end;
  1438.  
  1439. procedure stop_playing;
  1440. var
  1441. n : integer;
  1442. begin
  1443.   int_rate := 65535;
  1444.   set_timer(65535);
  1445.   setintvec(8,@oldint);
  1446.   for n := 0 to maxchn-1 do GusStopVoice(n);
  1447.   for n := 0 to maxchn-1 do begin
  1448.     channels[n].hit := 0;
  1449.     channels[n].bar := 0;
  1450.   end;
  1451.   playing := false;
  1452. end;
  1453.  
  1454. procedure start_playing;
  1455. var
  1456. n : integer;
  1457. begin
  1458.   if not loaded then exit;
  1459.   playing := true;
  1460.   for n := 0 to maxchn-1 do initchn(n);
  1461.   speed := 6;
  1462.   nspeed := 6;
  1463.   tempo := 125;
  1464.   channels[0].pan := 7-def_pan;
  1465.   channels[1].pan := 8+def_pan;
  1466.   channels[2].pan := 8+def_pan;
  1467.   channels[3].pan := 7-def_pan;
  1468.   if maxchn > 4 then for n := 4 to maxchn-1 do
  1469.     channels[n].pan := channels[n-4].pan;
  1470.   if maxchn > 8 then for n := 8 to maxchn-1 do
  1471.     channels[n].pan := channels[n-8].pan;
  1472.   for n := 0 to maxchn-1 do gussetbalance(n,channels[n].pan);
  1473.   jump := 0;
  1474.   int_tick := 0;
  1475.   cur_ptn := 0;
  1476.   cur_row := 0;
  1477.   new_ptn := 0;
  1478.   new_row := 0;
  1479.   cur_tick := 0;
  1480.   time_counter := 0;
  1481.   time_counter2 := 0;
  1482.   virt_warnptn(orders[0]);
  1483.   virt_needptn(orders[0]);
  1484.   asm cli end;
  1485.   setintvec(8,@modint);
  1486.   timer_rate := 20;
  1487.   timer_cnt := 20;
  1488.   int_rate := 1193182 div 1000;
  1489.   set_timer(int_rate);
  1490.   asm sti end;
  1491. end;
  1492.  
  1493. begin
  1494. end.
  1495.